Untitled
Habet Madoyan
11/27/2019
load("usa.rda")
load("usa_i.rda")
network::list.vertex.attributes(usa)## [1] "country" "lat" "long" "na"
## [5] "type" "vertex.names"network::list.edge.attributes(usa)## [1] "na" "weight"plot(usa)
edge_density(usa_i)## [1] 0.01505828mean_distance(usa_i, directed = T)## [1] 3.50756get_diameter(usa_i)## + 13/610 vertices, named, from c2d1148:
## [1] LPS WSX DHB RCE FBS LKE SEA JNU ANC BET OOK TNK WWTi_list <- list()
for(i in 1:1000){
i_list[[i]] <- erdos.renyi.game(n = gorder(usa_i), p.or.m = edge_density(usa_i),
type = "gnp")
}
avg_dist <- unlist(lapply(i_list, mean_distance, directed = T))igraph::list.vertex.attributes(usa_i)## [1] "country" "lat" "long" "na" "type" "name"table(V(usa_i)$type)##
## closed large_airport medium_airport seaplane_base small_airport
## 2 134 318 26 130type_num <- as.numeric(as.factor(V(usa_i)$type))
assortativity(usa_i, type_num)## [1] 0.3529708assortativity.degree(usa_i, directed=T)## [1] -0.3146973reciprocity(usa_i)## [1] 0.9678227ggplot()+geom_histogram(aes(x=avg_dist))+
geom_vline(xintercept = mean_distance(usa_i, directed=T), size=1.2, color="red")## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
ego(usa_i,1, "JFK", mode=c("out"))## [[1]]
## + 58/610 vertices, named, from c2d1148:
## [1] JFK ABQ ATL AUS BNA BOS BTV BUF BUR BWI CHS CLE CLT CMH CVG DCA DEN
## [18] DFW DTW FLL HNL HOU IAD IND JAX LAS LAX LGB MCO MIA MSP MSY OAK ORD
## [35] ORF PBI PDX PHL PHX PIT PWM RDU RIC ROC RSW SAN SAT SAV SDF SEA SFO
## [52] SJC SLC SMF SRQ STL SYR TPAego(usa_i,2, "JFK", mode=c("out"))## [[1]]
## + 386/610 vertices, named, from c2d1148:
## [1] JFK ABQ ATL AUS BNA BOS BTV BUF BUR BWI CHS CLE CLT CMH CVG DCA DEN
## [18] DFW DTW FLL HNL HOU IAD IND JAX LAS LAX LGB MCO MIA MSP MSY OAK ORD
## [35] ORF PBI PDX PHL PHX PIT PWM RDU RIC ROC RSW SAN SAT SAV SDF SEA SFO
## [52] SJC SLC SMF SRQ STL SYR TPA CNM DAL IAH LAM MCI MDW ABE ABY AEX AGS
## [69] ALB ATW AVL AVP AZO BDL BHM BMI BQK BTR CAE CAK CHA CHO CID COS CRW
## [86] CSG DAB DAY DHN DSM ECP ELP EVV EWN EWR EYW FAR FAY FNT FSD FSM FWA
## [103] GNV GPT GRB GRK GRR GSO GSP GTR HPN HSV ICT ILM JAN LAN LEX LFT LGA
## [120] LIT LWB MBS MCN MDT MEI MEM MGM MHT MKE MLB MLI MLU MOB MSL MSN MYR
## [137] OAJ OKC OMA PHF PIA PIB PNS PVD ROA SBN SGF SHV SNA TLH TRI TTN TUL
## [154] TUP TUS TYS VLD VPS XNA HRL LBB AHN MKL ACK ACY AUG BHB HYA ISP LEB
## + ... omitted several verticesego_size(usa_i,2, "JFK", mode=c("out"))## [1] 386neighbors(usa_i, "JFK", mode="in")## + 57/610 vertices, named, from c2d1148:
## [1] ABQ ATL AUS BNA BOS BTV BUF BUR BWI CHS CLE CLT CMH CVG DCA DEN DFW
## [18] DTW FLL HNL HOU IAD IND JAX LAS LAX LGB MCO MIA MSP MSY OAK ORD ORF
## [35] PBI PDX PHL PHX PIT PWM RDU RIC ROC RSW SAN SAT SAV SDF SEA SFO SJC
## [52] SLC SMF SRQ STL SYR TPAd_out <- igraph::degree(usa_i, mode = "out", normalized = T)
which.max(d_out)## ATL
## 41d_out[41]## ATL
## 0.2512315d_out <- igraph::degree(usa_i, mode = "out")
which.max(d_out)## ATL
## 41d_out[41]## ATL
## 153ggplot()+geom_histogram(aes(x=d_out))+
labs(x="Outgoing Flights",
title="Histogram of outgoing flights")## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
d_in <- igraph::degree(usa_i, mode = "in", normalized = T)
which.max(d_in)## ATL
## 41d_in[41]## ATL
## 0.2495895ggplot()+geom_histogram(aes(x=d_in))## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
f_in <- strength(usa_i, mode = "in")
which.max(f_in)## ATL
## 41f_in[41]## ATL
## 741ggplot()+geom_histogram(aes(x=f_in))+
labs(x="Flights", title="Distribution of incoming flights")## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
close <- igraph::closeness(usa_i,weights = 1/E(usa_i)$weight,
normalize=T, mode="all")## Warning in igraph::closeness(usa_i, weights = 1/E(usa_i)$weight, normalize
## = T, : At centrality.c:2617 :closeness centrality is not well-defined for
## disconnected graphsdf_c <- data.frame(airports=names(close),closeness=close)
df_c <- df_c[order(df_c$closeness, decreasing=T),]
head(df_c)bet <- igraph::betweenness(usa_i, weights = 1/E(usa_i)$weight,
normalize=T)
sort(bet, decreasing = T)[1:5]## ATL ANC SEA DEN BET
## 0.59797321 0.39785328 0.36462840 0.14840369 0.09277279p_rank <- page_rank(usa_i)$vector
sort(p_rank, decreasing = T)[1:10]## ATL DEN ORD DFW LAX ANC
## 0.04406593 0.02492413 0.02414507 0.02214536 0.01939483 0.01532216
## CLT PHX MSP LAS
## 0.01433456 0.01388004 0.01315252 0.01298363usa_i1 <- as.undirected(usa_i, mode = "collapse")
com <- fastgreedy.community(usa_i1)
sizes(com)## Community sizes
## 1 2 3 4 5 6 7 8 9 10 11 12 13
## 155 144 104 151 28 4 5 6 4 2 2 2 3plot(com, usa_i1)
s <- coreness(usa_i, mode="all")
s## ABE ABI ABL ABQ ABR ABY ACK ACT ACV ACY ADK ADQ AET AEX AGN AGS AHN AIA
## 18 2 3 38 2 2 6 2 4 18 2 2 4 6 2 6 2 2
## AIN AKB AKI AKK AKN AKP ALB ALO ALS ALW AMA ANC ANI ANV AOO AOS APF APN
## 4 2 4 2 4 4 34 2 4 2 11 20 5 4 4 1 2 4
## ARC ART ASE ATK ATL ATT ATW ATY AUG AUK AUS AVL AVP AZA AZO BDL BET BFD
## 2 4 4 4 56 3 14 4 2 4 56 16 12 18 8 44 5 4
## BFF BFI BFL BGM BGR BHB BHM BIL BIS BJI BKC BKG BKW BLD BLI BLV BMI BNA
## 2 2 10 6 12 2 36 14 10 2 4 8 3 2 18 2 16 56
## BOI BOS BPT BQK BRD BRL BRO BRW BTI BTM BTR BTT BTV BUF BUR BWI BZN CAE
## 28 56 2 2 4 4 4 5 4 2 8 4 20 40 22 56 14 20
## CAK CDB CDC CDR CDV CEC CEM CEZ CGA CGI CHA CHO CHS CHU CIC CID CIK CIU
## 22 2 2 2 4 4 2 2 5 2 16 12 39 2 2 18 4 2
## CKB CKD CKX CLD CLE CLL CLM CLT CMH CMI CMX CNM CNY COD COS COU CPR CRP
## 4 2 2 2 56 4 2 56 54 4 2 2 2 4 22 4 6 7
## CRW CSG CVG CWA CXF CYF CYS DAB DAL DAY DBQ DCA DDC DEC DEN DFW DHB DHN
## 12 2 56 6 2 4 2 4 29 32 2 56 4 4 56 56 2 2
## DIK DLG DLH DRG DRO DSM DTW DUJ DUT EAR EAT EAU ECP EDA EEK EGE EGX EKO
## 4 4 8 4 6 28 56 4 2 2 2 2 10 2 4 2 2 2
## ELD ELI ELM ELP ELV EMK ENA ERI ESC ESD EUG EVV EWB EWN EWR EXI EYW FAI
## 4 4 10 25 2 4 2 6 2 2 18 8 5 4 56 2 16 5
## FAR FAT FAY FBS FCA FKL FLG FLL FLO FMN FNT FOE FRD FSD FSM FWA FYU GAL
## 18 20 8 2 10 4 2 56 2 4 16 2 2 18 4 18 4 5
## GAM GCC GCK GCN GCW GDV GEG GFK GGG GGW GJT GLH GLV GNU GNV GPT GRB GRI
## 4 6 2 2 2 2 20 8 2 2 12 2 4 2 10 8 8 6
## GRK GRR GSO GSP GST GTF GTR GUC HCR HDN HGR HHH HIB HKB HLN HNH HNL HNM
## 6 34 24 34 4 12 2 2 4 2 4 4 2 2 9 4 36 2
## HNS HOB HOM HON HOT HOU HPB HPN HRL HRO HSL HSV HTS HUS HVN HVR HYA HYG
## 4 2 2 2 4 54 3 22 12 4 5 18 8 4 2 2 5 2
## HYL IAD IAG IAH IAN ICT IDA IGG IGM IKO ILG ILI ILM IMT IND INL IPL IPT
## 5 56 10 56 4 21 8 2 4 2 12 2 10 4 54 4 4 2
## IRC IRK ISN ISP ITH ITO JAC JAN JAX JBR JFK JHM JHW JLN JNU JST KAE KAL
## 2 2 4 18 6 6 4 18 48 2 56 4 4 2 5 4 2 4
## KBC KCC KCG KCL KCQ KFP KGX KKA KKB KKH KKI KLG KLL KLN KLW KOA KOT KOZ
## 2 2 2 2 2 2 4 5 1 4 4 5 2 1 4 18 4 2
## KPB KPN KPR KPV KQA KSM KTB KTN KTS KUK KVC KVL KWF KWK KWN KWT KYK KYU
## 2 4 1 2 2 4 5 5 4 3 2 3 2 4 4 4 1 4
## KZB LAM LAN LAR LAS LAW LAX LBB LBE LBF LBL LCH LCK LEB LEX LFT LGA LGB
## 1 2 12 2 56 2 56 12 6 2 4 4 4 4 22 6 54 24
## LIH LIT LKE LMA LMT LNK LNS LNY LPS LRD LSE LUK LUR LWB LWS LYH MAF MBL
## 20 29 2 2 4 6 2 5 2 6 4 4 2 4 6 2 12 2
## MBS MCE MCG MCI MCK MCN MCO MDT MDW MEI MEM MFE MFR MGM MGW MHK MHT MIA
## 8 2 4 56 2 4 56 20 56 2 54 6 14 6 4 4 26 56
## MKE MKG MKK MKL MLB MLI MLL MLU MLY MMH MMU MOB MOD MOT MOU MQT MRY MSL
## 54 2 5 4 4 18 3 6 1 2 4 10 2 8 4 4 12 2
## MSN MSO MSP MSS MSY MTJ MUE MVY MWA MYR MYU NIB NKI NLG NME NUI NUL NUP
## 22 14 56 2 56 2 2 6 2 24 2 2 2 2 2 4 4 3
## OAJ OAK OBU OGD OGG OGS OKC OLF OMA OME ONT OOK ORD ORF ORH ORV OTH OTZ
## 6 36 3 2 26 2 37 2 38 5 26 2 56 36 4 4 4 4
## OWB PAH PBG PBI PDT PDX PEC PGA PGD PGV PHF PHL PHO PHX PIA PIB PIE PIH
## 4 2 10 34 2 47 2 4 18 2 10 56 4 56 18 2 18 2
## PIP PIR PIT PIZ PKA PKB PLN PNS PPV PQI PQS PRC PSC PSG PSM PSP PTH PTU
## 2 4 56 4 2 2 2 22 2 2 4 2 16 4 2 26 2 2
## PUB PUW PVC PVD PVU PWM RAP RBY RCE RDD RDM RDU RDV RFD RHI RIC RIW RKD
## 2 4 2 34 6 14 14 5 2 2 12 56 2 10 4 36 2 2
## RKS RMP RNO ROA ROC ROW RSH RST RSW RUT SAF SAN SAT SAV SBA SBN SBP SBY
## 6 2 27 18 34 2 5 6 48 2 6 56 54 26 12 18 6 4
## SCC SCE SCK SCM SDF SDP SDY SEA SFB SFO SGF SGU SGY SHD SHG SHH SHR SHV
## 5 8 2 3 45 2 2 56 22 56 18 4 4 3 3 4 2 10
## SHX SIT SJC SJT SKK SLC SLK SLN SLQ SMF SMK SMX SNA SNP SOW SPI SPS SRQ
## 4 4 36 2 5 56 2 2 2 37 4 4 34 4 4 4 2 12
## SRV STC STG STL STS SUX SVA SVC SVS SWF SXP SYB SYR TAL TBN TCT TEB TKE
## 2 4 4 56 8 2 4 2 4 10 4 1 28 5 2 2 2 2
## TKJ TLA TLH TLJ TLT TNC TNK TOG TOL TPA TRI TTN TUL TUP TUS TVC TVF TWF
## 2 4 14 2 4 2 2 2 8 56 8 26 32 2 31 6 2 2
## TXK TYR TYS UGB UIN UNK UST VAK VCT VDZ VEE VEL VIS VLD VPS WAA WBB WBQ
## 2 4 28 2 2 5 2 3 2 2 2 2 2 2 10 4 4 4
## WLK WMO WNA WRG WRL WSN WSX WTK WTL WWP WWT XNA YAK YKM YNG YUM
## 2 4 2 4 2 2 2 3 3 2 2 26 4 2 8 4nba passing
load("n_pass.rda")
i_pass <- asIgraph(n_pass)
igraph::list.edge.attributes(i_pass)## [1] "FGP" "na" "passes"igraph::list.vertex.attributes(i_pass)## [1] "na" "ngames" "position" "vertex.names"i_pass <- igraph::set.edge.attribute(i_pass, "weight", value = E(i_pass)$passes)
i_pass <- igraph::set.vertex.attribute(i_pass, "name", value=V(i_pass)$vertex.names)edge_density(i_pass)## [1] 0.9571429mean_distance(i_pass, directed=T)## [1] 1.042857pos_num <- as.numeric(as.factor(V(i_pass)$position))
assortativity(i_pass, pos_num)## [1] -0.1298526actual <- assortativity(i_pass, pos_num)
results <- vector(length=1000)
for(i in 1:1000){
results[i] <- assortativity(i_pass,sample(pos_num))
}ggplot()+geom_histogram(aes(x=results))+
geom_vline(xintercept = actual,
size=1.2, color="red")## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
Degree assortativity
assortativity.degree(i_pass)## [1] -0.1968207reciprocity(i_pass)## [1] 0.9850746Passes recieved
recieved <- strength(i_pass, mode="in")
recieved## Patrick McCaw Jordan Bell Damian Jones Quinn Cook
## 1101 843 66 1334
## Kevon Looney Draymond Green Klay Thompson Stephen Curry
## 777 3446 2847 2993
## JaVale McGee Nick Young Kevin Durant Andre Iguodala
## 470 1197 3302 1916
## Shaun Livingston Zaza Pachulia David West
## 1740 1017 1323gave <- strength(i_pass, mode="out")
gave## Patrick McCaw Jordan Bell Damian Jones Quinn Cook
## 1075 1207 72 1251
## Kevon Looney Draymond Green Klay Thompson Stephen Curry
## 1072 4352 1935 2539
## JaVale McGee Nick Young Kevin Durant Andre Iguodala
## 593 904 2738 2186
## Shaun Livingston Zaza Pachulia David West
## 1764 1351 1333df_p <- data.frame(gave, recieved, players=names(recieved))
ggplot(df_p, aes(recieved, gave, label=players))+
geom_point()+geom_label()+ ggtitle("Given and recieved passes")
igraph::degree(i_pass)## Patrick McCaw Jordan Bell Damian Jones Quinn Cook
## 28 28 22 28
## Kevon Looney Draymond Green Klay Thompson Stephen Curry
## 28 28 28 26
## JaVale McGee Nick Young Kevin Durant Andre Iguodala
## 24 28 28 28
## Shaun Livingston Zaza Pachulia David West
## 28 24 26pass_close <- igraph::closeness(i_pass, weights = 1/E(i_pass)$weight,
normalized = T, mode="all")
sort(pass_close, decreasing = T)## Kevin Durant Klay Thompson Shaun Livingston Draymond Green
## 67.188228 45.044500 42.073977 39.991437
## Nick Young Quinn Cook Andre Iguodala Jordan Bell
## 34.068554 32.209315 30.687023 24.852371
## Stephen Curry Kevon Looney Patrick McCaw JaVale McGee
## 19.935498 15.166185 11.763825 5.813898
## Zaza Pachulia David West Damian Jones
## 5.459719 4.376948 3.568174pass_bet <- igraph::betweenness(i_pass, weights = 1/E(i_pass)$weight,
normalized = T)
sort(pass_bet, decreasing=T)## Draymond Green Kevin Durant Stephen Curry Quinn Cook
## 0.434065934 0.153846154 0.148351648 0.142857143
## Klay Thompson Shaun Livingston Patrick McCaw Jordan Bell
## 0.010989011 0.005494505 0.000000000 0.000000000
## Damian Jones Kevon Looney JaVale McGee Nick Young
## 0.000000000 0.000000000 0.000000000 0.000000000
## Andre Iguodala Zaza Pachulia David West
## 0.000000000 0.000000000 0.000000000p_rank <- page_rank(i_pass)$vector
sort(p_rank, decreasing = T)## Draymond Green Kevin Durant Stephen Curry Klay Thompson
## 0.13665118 0.12123153 0.10656721 0.10409694
## Andre Iguodala Shaun Livingston David West Quinn Cook
## 0.07739258 0.07002230 0.05821080 0.05800035
## Nick Young Patrick McCaw Zaza Pachulia Jordan Bell
## 0.05171995 0.04812526 0.04717387 0.04173471
## Kevon Looney JaVale McGee Damian Jones
## 0.03920867 0.02738581 0.01247885transitivity(i_pass)## [1] 0.9744186plot(n_pass, vertex.cex=10*pass_bet, displaylabels=T)
x <- (pass_close-mean(pass_close))/sd(pass_close)
plot(n_pass, vertex.cex=x, displaylabels=T)
plot(n_pass, vertex.cex=10*p_rank, displaylabels=T)